home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD Classic 39
/
CD CLASSIC #39 (1998).iso
/
EMPRESA
/
visio
/
Vistdstd
/
Install
/
Data.Z
/
Visreg.BAS
< prev
next >
Wrap
BASIC Source File
|
1996-08-13
|
15KB
|
441 lines
Attribute VB_Name = "VISREG"
' VISREG.BAS - Visio Instance Registration Utilites
' Copyright (C) 1991-1996 Visio Corporation. All rights reserved.
'
'
' Abstract Contains helper functions for working with Visio instances.
' To use this module include it into your project and use one
' of the three levels available. For more information see
' below.
'
' The registration utility offers an easy way get and create
' Visio instance objects. It offers three levels of instancing
' from simple get/create/release to registration where the
' library maintains the "signature" of a Visio instance and
' warns you when the active instance changes.
'
' The library maintains a static global g_appVisio which
' is called the global instance object (GIO). Use GIO in
' your code when refering to the working instance of Visio.
' Never apply the Set operator to GIO yourself (unless you
' really know what your doing).
'
' To use the library, include it in your project and refer the
' visio application object through g_appVisio (GIO).
' Read the sections below to find the level of functionality
' you want.
'
' Low Level Routines
'
' The low level routines are almost identical to what you
' would use normally with GetObject and CreateObject.
' However they encapsulate the error handling.
'
' vaoGetGIO() Retrieves active, running instances.
' vaoCreateGIO() Creates a new instance.
' vaoReleaseGIO() Release the GIO instance if Set.
' vaoIsGIOValid() Verifies that GIO is Set and loaded.
'
' Registration/Release Level
'
' Use this level when you need the registration functions
' to maintain the GIO but want control over how it is
' obtained. The procedures are:
'
' vaoRegisterGIO()
' vaoUnRegistrGIO()
' vaoReSetGIO()
' (vaoReleaseGIO() [From low level])
'
' To begin you register your instance and choose how to
' retrieve the GIO (Get/Create/Both) with
' vaoRegisterGIO() and use vaoUnRegisterGIO to release
' it. This gives a good amount of flexibility but leaves
' it up to you to handle the conditions where Visio is shut
' down or a new instance is loaded. At this level you keep
' the instance registered but release the GIO using
' vaoReleaseGIO. To get back GIO use vaoReSetGIO.
'
' Most Common Level
'
' This is highest, most abstract level. It's called Most
' Common level because most scripts will probably use it
' to get instance objects. There is one function:
'
' vaoGetObject()
'
' When called it will check to see if the GIO is already
' registered. If not it will first attempt a GetObject
' and, if that fails, will use CreateObject. Unless Visio
' is not installed, you will get visOK back. On subsequent
' calls it checks that it is still valid (not UnSet and
' still running). If so it returns visOK, otherwise it
' tries to register the GIO again. If that fails you
' receive visError. The nice thing about this is that one
' call maintains the GIO for you.
'
Option Explicit '-- All Variable Explicit!
' Declare the global Application object using the type library reference.
' Change this to Global g_appVisio As Object if you choose not to use the
' type library.
Global g_appVisio As Visio.Application
Const REG_GET_HWND = 1
Const REG_SET_HWND = 2
Global Const visDiffInst = 1
Global Const visGet = 2
Global Const visCreate = 3
Global Const visVisioQuit = 4
Global Const visError = 5
Global Const visRegistered = 6
Global Const visOK = 7
Private Function GetHWND()
'-------------------------------
'--- GetHWND -------------------
'--
'-- Returns the registered Visio Window Handle.
'--
Dim iTemp As Integer
VisWindowHandle REG_GET_HWND, iTemp
GetHWND = iTemp
End Function
Private Function Registered() As Integer
'-------------------------------
'--- RegisterVisio -------------
'--
'-- Returns boolean integer indicating if we are registered or not.
'--
Registered = (GetHWND() <> 0)
End Function
Private Sub SetHWND(ByVal iNewHWND As Integer)
'-------------------------------
'--- SetHWND -------------------
'--
'-- Sets the registered Visio Window Handle.
'--
VisWindowHandle REG_SET_HWND, iNewHWND
End Sub
Function vaoCreateGIO() As Integer
'-------------------------------
'--- vaoCreateGIO --------------
'--
'-- Uses CreateObject to create a new instance of Visio. If it fails
'-- False is returned, otherwise the GIO is set to the instance created
'-- and True is returned.
'--
On Error GoTo vaoCreateGIOErrorHandler
Debug.Print "VISREG.BAS vaoCreateGIO() - Creating new Visio instance."
Set g_appVisio = CreateObject("visio.application")
If Not (g_appVisio Is Nothing) Then
vaoCreateGIO = True
End If
Exit Function
vaoCreateGIOErrorHandler:
Debug.Print "VISREG.BAS vaoCreateGIO() - Failed."
Exit Function
Resume Next
End Function
Function vaoGetGIO() As Integer
'-------------------------------
'--- vaoGetGIO -----------------
'--
'-- Uses GetObject to get the active instance of Visio. If GetObject fails
'-- False is returned, otherwise the GIO is set and True is returned.
'--
On Error GoTo vaoGetErrorHandler
Debug.Print "VISREG.BAS vaoGetGIO() - Retrieving active Visio instance."
Set g_appVisio = GetObject(, "visio.application")
If Not (g_appVisio Is Nothing) Then
vaoGetGIO = True
End If
Exit Function
vaoGetErrorHandler:
Debug.Print "VISREG.BAS vaoGetGIO() - Failed."
Exit Function
Resume Next
End Function
Function vaoGetObject() As Integer
'-------------------------------
'--- vaoGetObject --------------
'--
'-- Uses registration procedures to maintain the GIO. This funciton makes
'-- up the Common Use Layer (most commonly used procedure) for using the GIO.
'-- Just call it every time you need to work with Visio and it will make sure
'-- you have a valid working copy.
'--
'-- Return Values:
'-- visOK - The GIO is set to a valid working instance of Visio.
'-- visError - Visio or OLE not installed or some other serious
'-- error occurred.
'--
Dim iRetVal As Integer, iTemp As Integer, l_appVisio As Object
iRetVal = visOK '-- Default To OK
If Registered() Then '-- When Registerd...
If Not vaoIsGIOValid() Then '-- If GIO Is Valid...
Debug.Print "VISREG.BAS vaoGetObject() - Re-registering instance."
'-- Somehow the GIO is no longer valid, either because it was
'-- vaoReleaseGIO'd or is no longer running. Therefore we just
'-- try to re-register and if the same instance is active, we
'-- get that one again. Otherwise we end up with the active
'-- instance of Visio or a newly created one.
'--
'-- In future versions of Visio we will iterate through the
'-- instance collection and retrieve the instance we originally
'-- registered to if it still exists.
vaoUnRegisterGIO '-- Oops, Its Bad Now...
If vaoRegisterGIO(True, True) = visError Then
iRetVal = visError
End If
End If
Else
If vaoRegisterGIO(True, True) = visError Then
iRetVal = visError
End If
End If
vaoGetObject = iRetVal
End Function
Function vaoGetVisio(bGet As Integer, bCreate As Integer) As Integer
'-------------------------------
'--- vaoGetVisio ---------------
'--
'-- Identical to vaoRegisterGIO except doesn't use registration functions.
'--
'-- Parameters : bUseExisting - Boolean - Use vaoGetGIO() first.
'-- bCreate - Boolean - Use vaoCreateGIO().
'--
'-- Returns : visError - If an error occurred and the GIO could not be
'-- set. Either the flags were invalid or
'-- Get & Create failed.
'-- visGet - When a vaoGetGIO() retrieved the GIO.
'-- visCreate - When a vaoCreateGIO() retrieved the GIO.
'-- visRegisterd - Failed - GIO is registered. Use
'-- vaoUnRegisterGIO().
'--
Dim iRetVal As Integer
' If registered we fail.
'
If Registered() Then
iRetVal = visRegistered
GoTo lblGetVisioCleanUp
End If
iRetVal = visError
' If the Get flag was set we first try vaoGetGIO()
'
If bGet Then
If vaoGetGIO() Then iRetVal = visGet
End If
' If the Create flag is on and the return value doesn't indicate that
' a get worked then we use create.
'
If bCreate And (iRetVal <> visGet) Then
If vaoCreateGIO() Then iRetVal = visCreate
End If
' If the GIO isn't set at this point we output an error message.
'
If g_appVisio Is Nothing Then
Debug.Print "VISREG.BAS vaoGetVisio() - Error registering GIO."
End If
lblGetVisioCleanUp:
vaoGetVisio = iRetVal
End Function
Function vaoIsGIOValid() As Integer
'-------------------------------
'--- vaoIsGIOValid -------------
'--
'-- Our validity test simply checks to see if the GIO is set and, if so,
'-- checks if it is loaded.
'--
'-- Returns : True if GIO is set and loaded, False otherwise.
'--
On Error GoTo lblvaoGIOValidErr
Dim iTemp As Integer
vaoIsGIOValid = False '-- Default To False
If (g_appVisio Is Nothing) Then Exit Function '-- Not Set
iTemp = g_appVisio.Documents.Count '-- Try A Property
vaoIsGIOValid = True '-- No Error - Valid!
Exit Function
lblvaoGIOValidErr:
Exit Function '-- Error - Invalid
Resume Next
End Function
Function vaoRegisterGIO(bUseExisting As Integer, bCreate As Integer) As Integer
'-------------------------------
'--- vaoRegisterGIO ------------
'--
'-- Registers the GIO using two parameters to decide how the Visio instance
'-- should be created. Use vaoUnRegisterGIO to reverse the registration.
'--
'-- Parameters : bUseExisting - If True then GetObject will tried first.
'-- bCreate - If True CreateObject will be called after
'-- any GetObject calls.
'--
'-- Returns : visError - If an error occurred and the GIO could not be
'-- registered because either the flags passed
'-- were invalid or Get & Create failed.
'-- visGet - When a GetObject retrieved the GIO.
'-- visCreate - When a CreateObject retrieved the GIO.
'-- visRegisterd - When already registered.
'--
Dim iRetVal As Integer
If Registered() Then
iRetVal = visRegistered
GoTo lblRegisterCleanUp
End If
iRetVal = visError
If bUseExisting Then
If vaoGetGIO() Then iRetVal = visGet
End If
If bCreate And (iRetVal <> visGet) Then
If vaoCreateGIO() Then iRetVal = visCreate
End If
If g_appVisio Is Nothing Then
Debug.Print "VISREG.BAS vaoRegisterGIO() - Error registering GIO."
Else
SetHWND g_appVisio.WindowHandle
End If
lblRegisterCleanUp:
vaoRegisterGIO = iRetVal
End Function
Sub vaoReleaseGIO()
'-------------------------------
'--- vaoReleaseGIO -------------
'--
'-- Handles releasing the GIO. Does not unregister the window handle.
'-- If using the registration interfaces use vaoReSetGIO to retrieve the
'-- GIO, otherwise you may use vaoGetGIO or vaoCreateGIO. This does not
'-- take affect until all other references go out of scope.
'--
Set g_appVisio = Nothing '-- Release Resources
Debug.Print "VISREG.BAS vaoReleaseGIO() - Complete."
End Sub
Function vaoReSetGIO() As Integer
'-------------------------------
'--- vaoReSetGIO ---------------
'--
'-- Tries to re-Set the GIO only if we are registered and the GIO is not
'-- already set.
'--
'-- Return Values :
'-- visError - If not registered or GIO is already set.
'-- visOK - If able to reSet the GIO to the registered instance.
'-- visVisioQuit - If Visio is no longer running. If so then the GIO is
'-- unregistered because the HWND is no longer valid.
'-- visDiffInst - If the registered instance is no longer running. The
'-- GIO is not set.
'--
vaoReSetGIO = visError
If Not Registered() Or Not (g_appVisio Is Nothing) Then Exit Function
If vaoGetGIO() Then
If g_appVisio.WindowHandle = GetHWND() Then
vaoReSetGIO = visOK
Else
vaoReleaseGIO
vaoReSetGIO = visDiffInst '-- Release GIO
End If
Else
vaoReSetGIO = visVisioQuit
vaoUnRegisterGIO '-- UnRegister
End If
End Function
Sub vaoUnRegisterGIO()
'-------------------------------
'--- vaoUnRegisterGIO ----------
'--
'-- Unregisters a visio instance by clearing the window handle and releasing
'-- the global instance object.
'--
SetHWND 0 '-- Resets HWND
vaoReleaseGIO '-- Releases GIO
Debug.Print "VISREG.BAS vaoUnRegisterGIO() - Completed."
End Sub
Private Sub VisWindowHandle(ByVal iAction As Integer, iArg As Integer)
'-------------------------------
'--- VisWindowHandle -----------
'--
'-- Maintains the registered window handle in a static variable.
'--
'-- Parameters : iAction - Specifies the action to perform. REG_GET_HWND
'-- sets iArg to the handle. REG_SET_HWND sets the
'-- handle to iArg.
'--
'-- iArg - Used in gets/sets.
'--
Static iHWND As Integer
Select Case iAction
Case REG_GET_HWND: iArg = iHWND
Case REG_SET_HWND: iHWND = iArg
Case Else:
Debug.Print "VISREG.BAS VisWindowHandle() - Invalid Action Passed"
End Select
End Sub